Attribute VB_Name = "modAutoTypeCombo"
Option Explicit

'*** NOTE: The calling form should use this set of events,
'***       replacing "Combo1" with the name of the combobox.

'Private Sub Combo1_GotFocus()
'    AutoTypeComboGotFocus Combo1
'End Sub
'Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
'    AutoTypeComboKeyDown Combo1, KeyCode, Shift
'End Sub
'Private Sub Combo1_KeyPress(KeyAscii As Integer)
'    AutoTypeComboKeyPress Me, Combo1, KeyAscii
'End Sub
'Private Sub Combo1_Change()
'    AutoTypeComboChange Combo1
'End Sub
'Private Sub Combo1_LostFocus()
'    AutoTypeComboLostFocus Combo1
'End Sub

Public gstrATCDBTableName           As String
Public gstrATCDBFieldName           As String
Public gblnGetAllData               As Boolean  ' true = get all entries, false = go by 1st letter
Public gblnDropDownOnFocus          As Boolean
Public m_BillInterface As BillEvent

Private Const CB_FINDSTRING         As Long = &H14C
Private Const CB_SHOWDROPDOWN       As Long = &H14F
Private Const LB_FINDSTRING         As Long = &H18F
Private Const CB_ERR                As Long = (-1)
Private Const CB_GETITEMHEIGHT      As Long = &H154
Private Const CB_SETDROPPEDWIDTH    As Long = &H160

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private gblnATCIgnoreTextChange As Boolean
Private gblnATCTextDeleted      As Boolean
Private gintATCSelStart         As Integer
Private gintATCSelLen           As Integer

'---------------------------------------------------------------------------------
Public Sub AutoTypeComboGotFocus(pobjCombo As ComboBox)
'---------------------------------------------------------------------------------

    ' Select existing text on entry to the combo box
    pobjCombo.SelStart = 0
    pobjCombo.SelLength = Len(pobjCombo.Text)
    
    ' if currently populated, drop it down
    If pobjCombo.ListCount > 0 And gblnDropDownOnFocus Then
        SendMessage pobjCombo.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&
    End If
    
End Sub

'---------------------------------------------------------------------------------
Public Sub AutoTypeComboKeyDown(pobjCombo As ComboBox, _
                                KeyCode As Integer, _
                                Shift As Integer)
'---------------------------------------------------------------------------------

    ' If the full text is selected and the user presses a letter or number,
    ' the selected text should be replaced
    If pobjCombo.SelText = pobjCombo.Text _
    And ((KeyCode >= vbKeyA And KeyCode <= vbKeyZ) Or _
         (KeyCode >= vbKey0 And KeyCode <= vbKey9)) _
    Then
        pobjCombo.Text = ""
        gblnATCTextDeleted = False
        pobjCombo.Refresh
        Exit Sub
    End If
    
    ' If a user presses the "Delete" key, then the selected text
    ' is removed.
    If KeyCode = vbKeyDelete And pobjCombo.SelText <> "" Then
        ' Make sure that the text is not automatically re-entered
        ' as soon as it is deleted
        gblnATCIgnoreTextChange = True
        gintATCSelStart = pobjCombo.SelStart + 1
        gintATCSelLen = pobjCombo.SelLength
        pobjCombo.SelText = ""
        KeyCode = 0
        gblnATCTextDeleted = True
    Else
        gblnATCTextDeleted = False
    End If
    
End Sub

'---------------------------------------------------------------------------------
Public Sub AutoTypeComboKeyPress(pobjForm As Form, _
                                 pobjCombo As ComboBox, _
                                 KeyAscii As Integer, m_BillInterface As BillEvent)
'---------------------------------------------------------------------------------
    
    ' If a user presses the "Backspace" key,  then the selected text
    ' is removed. Autosearch is not re-performed, as that would only
    ' put it straight back again.
    
    Dim objCtl  As Control

    If Len(pobjCombo.Text) = 0 Then
        gblnATCIgnoreTextChange = False
        LoadCombo pobjCombo, IIf(gblnGetAllData, "", Chr$(KeyAscii)), m_BillInterface
        If pobjCombo.ListCount > 0 Then
            SetDropDownHeight pobjForm, pobjCombo, IIf(pobjCombo.ListCount < 8, _
                                                       pobjCombo.ListCount, 8)
        End If
        pobjForm.Refresh
        On Error Resume Next
        For Each objCtl In pobjForm.Controls
            objCtl.Refresh
        Next
    End If
    
    If pobjCombo.ListCount > 0 Then
        SetDropDownWidth pobjCombo
        SendMessage pobjCombo.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&
    End If

    If KeyAscii = 8 Then
        gblnATCIgnoreTextChange = True
        If Len(pobjCombo.SelText) > 0 Then
            pobjCombo.SelText = ""
            KeyAscii = 0
        End If
    End If
    
    ''if user presses enter, select the listindex
    'If KeyAscii = 13 Then
    '    pobjCombo.ListIndex = SendMessage(pobjCombo.hwnd, _
    '                                      CB_FINDSTRING, _
    '                                      -1, _
    '                                      ByVal CStr(pobjCombo.Text))
    'End If
    
End Sub

'---------------------------------------------------------------------------------
Public Sub AutoTypeComboChange(pobjCombo As ComboBox)
'---------------------------------------------------------------------------------
    
    Dim i           As Integer
    Dim l           As Long
    Dim strNewText  As String
    
    ' Check to see if a search is required.
    If gblnATCTextDeleted Then Exit Sub

    If Not gblnATCIgnoreTextChange And pobjCombo.ListCount > 0 Then
        l = SendMessage(pobjCombo.hwnd, _
                        CB_FINDSTRING, _
                        -1, _
                        ByVal CStr(pobjCombo.Text))
        strNewText = pobjCombo.List(l)
        If Len(pobjCombo.Text) <> Len(strNewText) Then
            ' Partial match found
            ' Avoid recursively entering this event
            gblnATCIgnoreTextChange = True
            i = Len(pobjCombo.Text)
            ' Attach the full text from the list to what has already been entered.
            ' This technique preserves the case entered by the user.
            pobjCombo.Text = pobjCombo.Text & Mid$(strNewText, i + 1)
            ' Select the text that is auto-entered
            pobjCombo.SelStart = i
            pobjCombo.SelLength = Len(Mid$(strNewText, i + 1))
        End If
    Else
        ' The IgnoreTextChange Flag is only effective for one Change event.
        gblnATCIgnoreTextChange = False
    End If

End Sub

'---------------------------------------------------------------------------------
Public Sub AutoTypeComboLostFocus(pobjCombo As ComboBox)
'---------------------------------------------------------------------------------

    On Error Resume Next
    
    If gblnATCTextDeleted Then
        If Len(pobjCombo.Text) > 0 Then
            pobjCombo.Text = Left$(pobjCombo.Text, gintATCSelStart - 1) & _
                             Mid$(pobjCombo.Text, gintATCSelStart + gintATCSelLen)
            pobjCombo.AddItem pobjCombo.Text
        End If
    End If

End Sub

'---------------------------------------------------------------------------------
Public Sub LoadCombo(pobjCombo As ComboBox, pstrLetter As String, m_BillInterface As BillEvent)
'---------------------------------------------------------------------------------
    
    Dim objRstDropDownData  As ADODB.Recordset
    Dim strSQL              As String
    Dim strWhereClause      As String
    Dim strWhereOrAnd       As String
    If pstrLetter = "" Then
        strWhereClause = ""
        strWhereOrAnd = " WHERE "
    Else
        strWhereOrAnd = " AND "
        If UCase$(pstrLetter) >= "A" And UCase$(pstrLetter) <= "Z" Then
            strWhereClause = " WHERE " & gstrATCDBFieldName & " LIKE '" & pstrLetter & "%'"
        Else
            strWhereClause = " WHERE " & gstrATCDBFieldName & " LIKE '[!A-Z]%'"
        End If
    End If
    
         Dim Sql As String
     Sql = Sql & "select FItemID,FName from t_Supplier where FName like '%" & pstrLetter & "%'" & vbCrLf
     Set objRstDropDownData = m_BillInterface.K3Lib.GetData(Sql)
     'Combo1.DataMember
    
    With pobjCombo
        .Clear
        Do Until objRstDropDownData.EOF
            .AddItem objRstDropDownData.Fields("FName")
            objRstDropDownData.MoveNext
        Loop
    End With
    
    objRstDropDownData.Close
    
    Set objRstDropDownData = Nothing

End Sub

'---------------------------------------------------------------------------------
Public Sub SetDropDownHeight(pobjForm As Form, _
                             pobjCombo As ComboBox, _
                             plngNumItemsToDisplay As Long)
'---------------------------------------------------------------------------------

    Dim pt              As POINTAPI
    Dim rc              As RECT
    Dim lngSavedWidth   As Long
    Dim lngNewHeight    As Long
    Dim lngOldScaleMode As Long
    Dim lngItemHeight   As Long

    lngSavedWidth = pobjCombo.Width

    lngOldScaleMode = pobjForm.ScaleMode
    pobjForm.ScaleMode = vbPixels
    
    lngItemHeight = SendMessage(pobjCombo.hwnd, CB_GETITEMHEIGHT, 0, ByVal 0)
    
    lngNewHeight = lngItemHeight * (plngNumItemsToDisplay + 2)
    
    Call GetWindowRect(pobjCombo.hwnd, rc)
    pt.X = rc.Left
    pt.Y = rc.Top
    
    Call ScreenToClient(pobjForm.hwnd, pt)
    
    Call MoveWindow(pobjCombo.hwnd, pt.X, pt.Y, pobjCombo.Height, lngNewHeight, True)
    
    pobjForm.ScaleMode = lngOldScaleMode
    pobjCombo.Width = lngSavedWidth

End Sub

'-----------------------------------------------------------------------------
Public Sub SetDropDownWidth(mCombo As ComboBox)
'-----------------------------------------------------------------------------

    Dim RetVal As Long
    Dim PixelWidth As Long
    Dim MaxWidth As Long
    Dim LoopCounter As Long
    Dim lWidth As Long

    For LoopCounter = 0 To mCombo.ListCount - 1
        lWidth = mCombo.Parent.TextWidth(mCombo.List(LoopCounter))
        If lWidth > MaxWidth Then
            MaxWidth = lWidth
        End If
    Next LoopCounter

    MaxWidth = MaxWidth + (23 * Screen.TwipsPerPixelX)
    If MaxWidth > (mCombo.Width * 2) Then
        MaxWidth = (mCombo.Width * 2)
    ElseIf MaxWidth < mCombo.Width Then
        MaxWidth = mCombo.Width
    End If

    PixelWidth = (MaxWidth \ Screen.TwipsPerPixelX)
    RetVal = SendMessage(mCombo.hwnd, CB_SETDROPPEDWIDTH, PixelWidth, 0)
    
End Sub

